# Importo el df de resultadosTokyo tras el EDA realizado:
resultadosTokyo2025 <-readRDS("resultadosTokyo2025.rds")
# Importo las librerías necesarias:
source("librerias.R")1 Importacion de librerías y datos
2 Análisis de Componentes Principales
El Análisis de Componentes Principales (PCA, por sus siglas en inglés Principal Component Analysis) es una técnica de reducción de dimensionalidad no supervisada que transforma un conjunto de variables correlacionadas en un conjunto más pequeño de variables no correlacionadas llamadas componentes principales.
2.1 PCA sobre ritmos de carrera a través de los parciales
En esta sección se realiza un Análisis de Componentes Principales (PCA) para la categoría Élite. Se utilizan los tiempos reales de cada segmento de 5km junto con el segmento de 40km a meta, calculados a partir de los tiempos acumulados proporcionados en los parciales. A través de ellos, se dividirá cada parcial por el tiempo final del corredor con el objetivo de captar el porcentaje de tiempo que dedica a cada segmento durante la carrera. Por último y antes de iniciar el PCA, estandarizamos los datos para asegurar que los parciales de 5km y el de 2.195 km tengan la misma importancia en el análisis.
2.1.1 Preparación de datos
# Filtrar por categoría Élite
elite <- resultadosTokyo2025 %>%
filter(categoria == "Élite")
# Calcular parciales reales (tiempos de cada segmento)
elite <- elite %>%
mutate(
seg_0_5 = parcial_5km,
seg_5_10 = parcial_10km - parcial_5km,
seg_10_15 = parcial_15km - parcial_10km,
seg_15_20 = parcial_20km - parcial_15km,
seg_20_25 = parcial_25km - parcial_20km,
seg_25_30 = parcial_30km - parcial_25km,
seg_30_35 = parcial_35km - parcial_30km,
seg_35_40 = parcial_40km - parcial_35km,
seg_40_meta = tiempo_oficial - parcial_40km
)
# Normalizar por tiempo oficial (porcentaje de tiempo en cada segmento)
elite <- elite %>%
mutate(
rel_seg_0_5 = seg_0_5 / tiempo_oficial,
rel_seg_5_10 = seg_5_10 / tiempo_oficial,
rel_seg_10_15 = seg_10_15 / tiempo_oficial,
rel_seg_15_20 = seg_15_20 / tiempo_oficial,
rel_seg_20_25 = seg_20_25 / tiempo_oficial,
rel_seg_25_30 = seg_25_30 / tiempo_oficial,
rel_seg_30_35 = seg_30_35 / tiempo_oficial,
rel_seg_35_40 = seg_35_40 / tiempo_oficial,
rel_seg_40_meta = seg_40_meta / tiempo_oficial
)
# Seleccionar solo las variables para PCA
elite_pca_data <- elite %>%
select(Nombre, Genero, estrategia, starts_with("rel_seg_")) %>%
na.omit()
cat("✓ Datos preparados para categoría Élite\n")✓ Datos preparados para categoría Élite
cat("✓ Número de corredores:", nrow(elite_pca_data), "\n")✓ Número de corredores: 92
cat("✓ Variables:", ncol(elite_pca_data) - 3, "segmentos normalizados\n")✓ Variables: 9 segmentos normalizados
2.1.2 Análisis de Componentes Principales
# Realizar PCA (sin incluir las columnas Nombre, Genero, Estrategia)
pca_elite <- prcomp(elite_pca_data[, -c(1:3)], center = TRUE, scale. = TRUE)
# Resumen
cat("=== RESUMEN PCA - ÉLITE ===\n")=== RESUMEN PCA - ÉLITE ===
print(summary(pca_elite))Importance of components:
PC1 PC2 PC3 PC4 PC5 PC6 PC7
Standard deviation 2.2191 1.5855 0.84810 0.61372 0.44565 0.33824 0.31198
Proportion of Variance 0.5472 0.2793 0.07992 0.04185 0.02207 0.01271 0.01081
Cumulative Proportion 0.5472 0.8265 0.90642 0.94827 0.97034 0.98305 0.99386
PC8 PC9
Standard deviation 0.23502 1.921e-15
Proportion of Variance 0.00614 0.000e+00
Cumulative Proportion 1.00000 1.000e+00
# Autovalores
autovalores_elite <- pca_elite$sdev^2
cat("\n=== AUTOVALORES ===\n")
=== AUTOVALORES ===
print(autovalores_elite)[1] 4.924559e+00 2.513934e+00 7.192802e-01 3.766523e-01 1.986049e-01
[6] 1.144044e-01 9.733314e-02 5.523221e-02 3.690119e-30
# Varianza explicada
var_explicada <- round(autovalores_elite / sum(autovalores_elite) * 100, 2)
cat("\n=== VARIANZA EXPLICADA POR COMPONENTE (%) ===\n")
=== VARIANZA EXPLICADA POR COMPONENTE (%) ===
print(var_explicada)[1] 54.72 27.93 7.99 4.19 2.21 1.27 1.08 0.61 0.00
# Varianza acumulada
var_acum_elite <- cumsum(var_explicada)
cat("\n=== VARIANZA ACUMULADA (%) ===\n")
=== VARIANZA ACUMULADA (%) ===
print(var_acum_elite)[1] 54.72 82.65 90.64 94.83 97.04 98.31 99.39 100.00 100.00
Observamos que, con las 2 primeras componentes principales, se explica un 82.65% de la varianza total, lo que indica que estas dos componentes capturan la mayor parte de la información contenida en los datos originales.
2.1.3 Autovectores (Loadings)
A continuación, visualizamos los autovectores (loadings) correspondientes a las dos primeras componentes principales:
cat("=== AUTOVECTORES - PC1 y PC2 ===\n")=== AUTOVECTORES - PC1 y PC2 ===
print(pca_elite$rotation[, 1:2]) PC1 PC2
rel_seg_0_5 -0.3735426 -0.1912469
rel_seg_5_10 -0.3997243 -0.2086332
rel_seg_10_15 -0.4248876 -0.1053469
rel_seg_15_20 -0.3963012 0.1357340
rel_seg_20_25 -0.1636699 0.5122632
rel_seg_25_30 0.1295767 0.5315866
rel_seg_30_35 0.3009107 0.3113988
rel_seg_35_40 0.3879472 -0.2821189
rel_seg_40_meta 0.2801323 -0.4108733
Observamos que la primera componente principal (PC1) contiene una especie de media ponderada en la cual, se dan valores negativos de manera creciente a medida que avanzan los segmentos de la carrera. A partir de los 25km, los siguientes segmentos comienzan a tomar valores positivos de manera incremental, bajando un poco el valor del segmento desde los 40km a meta. Esto sugiere ¿?
Respecto a la segunda componente principal (PC2), se observan valores ligeramente negativos en los 3 primeros segmentos de la carrera, seguido de valores altamente positivos en los parciales de 20 a 30km y valores negativos en los dos últimos segmentos. Esto sugiere ¿?
2.1.4 Gráfica de PCA - Élite
# Preparar datos para graficar
scores_elite <- as.data.frame(pca_elite$x[, 1:2])
scores_elite$Nombre <- elite_pca_data$Nombre
scores_elite$Genero <- elite_pca_data$Genero
scores_elite$estrategia <- elite_pca_data$estrategia
# Mostrar algunos valores
cat("\n=== PRIMEROS 10 CORREDORES EN ESPACIO PC1-PC2 ===\n")
=== PRIMEROS 10 CORREDORES EN ESPACIO PC1-PC2 ===
print(head(scores_elite, 10)) PC1 PC2 Nombre Genero estrategia
1 -3.00929499 0.27091310 TADESE TAKELE Men Uniforme
2 -2.40197373 -0.27433337 DERESA GELETA Men Uniforme
3 -2.17541835 -0.45609304 VINCENT KIPKEMOI NGETICH Men Uniforme
4 -0.09199066 -0.10165290 TITUS KIPRUTO Men Positiva
5 -1.94426317 -0.36048314 MULUGETA ASEFA UMA Men Uniforme
6 -3.38502096 0.26856368 GEOFFREY TOROITICH Men Uniforme
7 0.20325598 -0.16819457 BENSON KIPRUTO Men Positiva
8 -3.21935698 -0.04320958 SULDAN HASSAN Men Uniforme
9 -1.71207172 -0.68418024 JOSHUA CHEPTEGEI Men Uniforme
10 -3.11607220 -0.08603310 TSUBASA ICHIYAMA Men Uniforme
2.1.4.1 Gráfico estático con ggplot2
# Gráfica estática básica
ggplot(scores_elite, aes(x = PC1, y = PC2, color = Genero, shape = estrategia)) +
geom_point(size = 4, alpha = 0.7) +
labs(
title = "PCA - Categoría Élite (por Género y Estrategia)",
x = paste0("PC1 (", var_explicada[1], "%)"),
y = paste0("PC2 (", var_explicada[2], "%)"),
color = "Género",
shape = "Estrategia"
) +
scale_color_manual(values = c("Men" = "#1976D2", "Women" = "#E91E63")) +
theme_minimal(base_size = 12) +
theme(
plot.title = element_text(face = "bold", size = 14, hjust = 0.5),
panel.grid.major = element_line(color = "gray90"),
panel.grid.minor = element_blank(),
legend.position = "right"
)2.1.4.2 Gráfico interactivo con plotly
library(plotly)
# Crear variable combinada para colores únicos por género y estrategia
scores_elite <- scores_elite %>%
mutate(grupo = paste0(Genero, " - ", estrategia))
# Definir paleta de colores combinada (género como tono base, estrategia como variación)
colores_combinados <- c(
# Hombres (tonos azules)
"Men - Negativa" = "#1E3A8A",
"Men - Positiva" = "#2563EB",
"Men - Uniforme" = "#60A5FA",
"Men - Variable" = "#93C5FD",
# Mujeres (tonos rosas/morados)
"Women - Negativa" = "#831843",
"Women - Positiva" = "#BE185D",
"Women - Uniforme" = "#EC4899",
"Women - Variable" = "#F9A8D4"
)
# Calcular rangos fijos de los ejes
rango_x <- range(scores_elite$PC1, na.rm = TRUE)
rango_y <- range(scores_elite$PC2, na.rm = TRUE)
margen_x <- diff(rango_x) * 0.1
margen_y <- diff(rango_y) * 0.1
# Crear figura base
fig <- plot_ly()
# Agregar trazas por cada combinación de género y estrategia
for (genero in unique(scores_elite$Genero)) {
for (estrat in unique(scores_elite$estrategia)) {
datos_grupo <- scores_elite %>%
filter(Genero == genero, estrategia == estrat)
if (nrow(datos_grupo) > 0) {
fig <- fig %>%
add_trace(
data = datos_grupo,
x = ~PC1,
y = ~PC2,
type = "scatter",
mode = "markers",
name = paste0(genero, " - ", estrat),
legendgroup = genero,
legendgrouptitle = list(text = genero),
marker = list(
size = 12,
color = colores_combinados[paste0(genero, " - ", estrat)],
opacity = 0.85,
line = list(
color = "white",
width = 1.5
)
),
text = ~paste0(
"<b style='font-size:14px'>", Nombre, "</b><br>",
"<br>",
"<b>Género:</b> ", Genero, "<br>",
"<b>Estrategia:</b> ", estrat, "<br>",
"<br>",
"<b>PC1:</b> ", round(PC1, 4), "<br>",
"<b>PC2:</b> ", round(PC2, 4)
),
hovertemplate = "%{text}<extra></extra>"
)
}
}
}
# Configurar layout con ejes fijos
fig <- fig %>%
layout(
title = list(
text = "<b>Análisis de Componentes Principales - Categoría Élite</b><br><sub>Estrategias de carrera en el Maratón de Tokio 2025</sub>",
font = list(
size = 18,
family = "Arial, sans-serif",
color = "#2C3E50"
),
x = 0.5,
xanchor = "center"
),
xaxis = list(
title = list(
text = paste0("<b>PC1 (", var_explicada[1], "%)</b>"),
font = list(size = 14, family = "Arial", color = "#34495E")
),
range = c(rango_x[1] - margen_x, rango_x[2] + margen_x),
fixedrange = FALSE,
gridcolor = "#E8E8E8",
gridwidth = 1,
showgrid = TRUE,
zeroline = TRUE,
zerolinecolor = "#95A5A6",
zerolinewidth = 2,
tickfont = list(size = 11, color = "#34495E")
),
yaxis = list(
title = list(
text = paste0("<b>PC2 (", var_explicada[2], "%)</b>"),
font = list(size = 14, family = "Arial", color = "#34495E")
),
range = c(rango_y[1] - margen_y, rango_y[2] + margen_y),
fixedrange = FALSE,
gridcolor = "#E8E8E8",
gridwidth = 1,
showgrid = TRUE,
zeroline = TRUE,
zerolinecolor = "#95A5A6",
zerolinewidth = 2,
tickfont = list(size = 11, color = "#34495E")
),
hovermode = "closest",
hoverlabel = list(
bgcolor = "white",
font = list(
family = "Arial, sans-serif",
size = 13,
color = "#2C3E50"
),
bordercolor = "#BDC3C7",
align = "left"
),
legend = list(
title = list(
text = "<b>Género y Estrategia</b>",
font = list(size = 13, family = "Arial")
),
font = list(size = 11, family = "Arial"),
orientation = "v",
x = 1.02,
y = 1,
bgcolor = "rgba(255, 255, 255, 0.95)",
bordercolor = "#BDC3C7",
borderwidth = 1,
tracegroupgap = 10
),
plot_bgcolor = "#FAFAFA",
paper_bgcolor = "#FFFFFF",
margin = list(l = 80, r = 180, t = 100, b = 80)
) %>%
config(
displayModeBar = TRUE,
displaylogo = FALSE,
modeBarButtonsToRemove = c("lasso2d", "select2d"),
toImageButtonOptions = list(
format = "png",
filename = "pca_elite_tokyo2025",
height = 800,
width = 1200,
scale = 2
)
)
# Mostrar gráfico
fig